home *** CD-ROM | disk | FTP | other *** search
/ Mac Mania 5 / MacMania 5.toast / / Tools&Utilities / Plotfoil 3.2 / naca-1.0 / nacafoil.f < prev    next >
Text File  |  1995-09-13  |  10KB  |  434 lines
  1. c
  2. c-----------------------------------------------------------------------------
  3. c
  4. c  NacaFoil.f -- generates a NACA foil section. The foil type is selected
  5. c                using the NACA foil descriptor.
  6. c
  7. c  Written By: S.E.Norris          
  8. c
  9. c  norris@cfd.mech.unsw.edu.au
  10. c
  11. c  $RCSfile: nacafoil.f,v $
  12. c  $Author: norris $
  13. c  $Revision: 1.5 $
  14. c  $Date: 1995/08/31 11:05:52 $
  15. c
  16. c  $Log: nacafoil.f,v $
  17. c  Revision 1.5  1995/08/31  11:05:52  norris
  18. c  *** empty log message ***
  19. c
  20. c  Revision 1.4  1995/08/31  03:35:01  norris
  21. c  Changed to use the directory.h header file that holds the directory name.
  22. c
  23. c  Revision 1.3  1995/08/31  02:03:05  norris
  24. c  Added the use of the lnblnk function to generate pathnames.
  25. c
  26. c  Revision 1.2  1995/08/30  11:48:41  norris
  27. c  Updated file so that it has alot of the non-standard F77 stuff removed.
  28. c
  29. c-----------------------------------------------------------------------------
  30. c
  31.       SUBROUTINE NacaFoil( x,npl,npmx,naca,scle,inaca,t_n,nmn )
  32. c
  33.       IMPLICIT none
  34.       INTEGER npl,npmx,inaca,nmn
  35.       REAL x(3,npmx),scle
  36.       CHARACTER naca*(*)
  37.       LOGICAL t_n
  38. c
  39. c  Converts a string into a NACA section.
  40. c
  41. c     x(i,j)   Contains the x,y coordinates of the foil
  42. c     npl      Number of points in foil description
  43. c     inaca    
  44. c     nmn      
  45. c     naca*(*) String containing the NACA foil number
  46. c     scle     Length to scale the foil by
  47. c     t_n      Returns weather we could generate the foil
  48. c
  49. c
  50.       t_n = .true.
  51. c
  52.       if (naca(3:3).eq.'-') then
  53.      if (naca(1:1).eq.'1') then
  54.         call Naca_1( x,npl,npmx,naca,inaca,scle,t_n )
  55.      else if (naca(1:1).eq.'6') then
  56.         call Naca_6( x,npl,npmx,naca,inaca,scle,t_n,nmn )
  57.      else
  58.         t_n = .false.
  59.      endif
  60.       else if (naca(3:3).eq.'A') then
  61.      call Naca_6( x,npl,npmx,naca,inaca,scle,t_n,nmn )
  62.       else if (naca(3:3).eq.'(') then
  63.      call Naca_6( x,npl,npmx,naca,inaca,scle,t_n,nmn )
  64.       else if (naca(5:5).eq.' ' .or. naca(5:5).eq.'-') then
  65.      call Naca_4( x,npl,npmx,naca,inaca,scle,t_n )
  66.       else if (naca(6:6).eq.' ' .or. naca(6:6).eq.'-') then
  67.      call Naca_5( x,npl,npmx,naca,inaca,scle,t_n )
  68.       else
  69.      t_n = .false.
  70.       endif
  71. c
  72.       return
  73.       END
  74. c
  75. c-----------------------------------------------------------------------------
  76. c
  77.       SUBROUTINE Naca_4( x,npl,npmx,naca,inaca,scle,t_n )
  78. c
  79.       IMPLICIT none
  80.       INTEGER npl,npmx,inaca
  81.       REAL x(3,npmx),scle
  82.       CHARACTER naca*(*)
  83.       LOGICAL t_n
  84. c
  85. c  Checks for correct 4-digit name, and checks for modified section
  86. c
  87.       LOGICAL modified
  88.       LOGICAL Digit
  89.       EXTERNAL Digit
  90. c
  91.       if (.not. Digit( naca(1:4),4 )) then
  92.      t_n = .false.
  93.       else if (naca(5:5).eq.'-') then
  94.      if (.not. Digit( naca(6:7),2 )) then
  95.         t_n = .false.
  96.      else
  97.         modified = .true.
  98.      endif
  99.       else
  100.      modified = .false.
  101.       endif
  102. c
  103.       if (t_n) then
  104.      call Naca4( x,npl,npmx,naca,inaca,scle,modified )
  105.       endif
  106. c
  107.       return
  108.       END
  109. c
  110. c-----------------------------------------------------------------------------
  111. c
  112.       SUBROUTINE Naca_5( x,npl,npmx,naca,inaca,scle,t_n )
  113. c
  114.       IMPLICIT none
  115.       INTEGER npl,npmx,inaca
  116.       REAL x(3,npmx),scle
  117.       CHARACTER naca*(*)
  118.       LOGICAL t_n
  119. c
  120. c  Checks for correct 5-digit name, and checks for modified section
  121. c
  122.       LOGICAL modified
  123.       LOGICAL Digit
  124.       EXTERNAL Digit
  125. c
  126.       if (.not. Digit( naca(1:5),5 )) then
  127.      t_n = .false.
  128.       else if (naca(6:6).eq.'-') then
  129.      if (.not. Digit( naca(7:8),2 )) then
  130.         t_n = .false.
  131.      else
  132.         modified = .true.
  133.      endif
  134.       else
  135.      modified = .false.
  136.       endif
  137. c
  138.       if (t_n) then
  139.      call Naca5( x,npl,npmx,naca,inaca,scle,modified )
  140.       endif
  141. c
  142.       return
  143.       END
  144. c
  145. c-----------------------------------------------------------------------------
  146. c
  147.       SUBROUTINE Naca_1( x,npl,npmx,naca,inaca,scle,t_n )
  148. c
  149.       IMPLICIT none
  150.       INTEGER npl,npmx,inaca
  151.       REAL x(3,npmx),scle
  152.       CHARACTER naca*(*)
  153.       LOGICAL t_n
  154. c
  155. c  Checks for correct 1-series name
  156. c
  157.       LOGICAL Digit
  158.       EXTERNAL Digit
  159. c
  160.       if (naca(2:2).ne.'6') then
  161.      t_n = .false.
  162.       else if (.not. Digit( naca(4:6),3 )) then
  163.      t_n = .false.
  164.       endif
  165. c
  166.       if (t_n) then
  167.      call Naca1( x,npl,npmx,naca,inaca,scle,t_n )
  168.       endif
  169. c
  170.       return
  171.       END
  172. c
  173. c-----------------------------------------------------------------------------
  174. c
  175.       SUBROUTINE Naca_6( x,npl,npmx,naca,inaca,scle,t_n,nmn )
  176. c
  177.       IMPLICIT none
  178.       INTEGER npl,npmx,inaca,nmn
  179.       REAL x(3,npmx),scle
  180.       CHARACTER naca*(*)
  181.       LOGICAL t_n
  182. c
  183. c  Checks for correct 6-series name
  184. c
  185.       INTEGER i
  186.       CHARACTER type*3
  187.       REAL a
  188.       REAL Rst
  189.       LOGICAL Digit
  190.       EXTERNAL Digit,Rst
  191. c
  192.       a = 1.0
  193. c
  194.       if (naca(1:1).ne.'6') then
  195.      t_n = .false.
  196.       else if (.not. Digit( naca(2:2),1 )) then
  197.      t_n = .false.
  198.       else if (naca(3:3).eq.'-') then
  199.      if (.not. Digit( naca(4:6),3 )) then
  200.         t_n = .false.
  201.      else if (naca(7:8).eq.'a=') then
  202.         a = Rst( 3,naca(9:11),1.0 )
  203.      endif
  204.      type = '-  '
  205.       else if (naca(3:3).eq.'A') then
  206.      if (.not. Digit( naca(4:6),3 )) then
  207.         t_n = .false.
  208.      else if (naca(7:8).eq.'a=') then
  209.         a = Rst( 3,naca(9:11),1.0 )
  210.      endif
  211.      type = 'A  '
  212. c
  213.       else if (naca(3:3).eq.'(') then
  214.      if (.not. Digit( naca(4:4),1 )) then
  215.         t_n = .false.
  216.      else if (.not.Digit( naca(5:5),1 )) then
  217.         if (naca(5:5).eq.')') then
  218.            i = 6
  219.            type(2:3) = '(1'
  220.         else
  221.            t_n = .false.
  222.         endif
  223.      else if (naca(6:6).eq.')') then
  224.         i = 7
  225.         type(2:3) = '(2'
  226.      else
  227.         t_n = .false.
  228.      endif
  229. c
  230.      if (t_n) then
  231.         if (naca(i:i).eq.'-') then
  232.            if (.not. Digit( naca(i+1:i+3),3 )) then
  233.           t_n = .false.
  234.            else if (naca(i+4:i+5).eq.'a=') then
  235.           a = Rst( 3,naca(i+6:i+8),1.0 )
  236.            endif
  237.            type(1:1) = '-'
  238.         else if (naca(i:i).eq.'A') then
  239.            if (.not. Digit( naca(i+1:i+3),3 )) then
  240.           t_n = .false.
  241.            else if (naca(i+4:i+5).eq.'a=') then
  242.           a = Rst( 3,naca(i+6:i+8),1.0 )
  243.            endif
  244.            type(1:1) = 'A'
  245.         else
  246.            t_n = .false.
  247.         endif
  248.      endif
  249.       else
  250.      t_n = .false.
  251.       endif
  252. c
  253.       call Naca6o( naca,inaca,type,t_n,nmn )
  254.       if (a.lt.0.0 .or. a.gt.1.0 )a = 1.0
  255.       if (t_n) then
  256.      call Naca6( x,npl,npmx,naca,inaca,scle,a,type,t_n )
  257.       endif
  258. c
  259.       return
  260.       END
  261. c
  262. c-----------------------------------------------------------------------------
  263. c
  264.       SUBROUTINE Naca6o( naca,inaca,type,t_n,nmn )
  265. c
  266.       IMPLICIT none
  267.       INTEGER inaca,nmn
  268.       CHARACTER naca*15,type*3
  269.       LOGICAL t_n
  270. c
  271. c  Checks that the NACA profile is valid. If it isnt, replaces it with
  272. c  the closest available profile.
  273. c
  274.       INCLUDE 'directory.h'
  275.       INTEGER ndata(3),ibase,im,i
  276. c     INTEGER icl,itau
  277.       CHARACTER string*15,filnme*6,fullpath*128
  278.       LOGICAL fex
  279.       CHARACTER Sti*2
  280.       INTEGER Lnblnk
  281.       EXTERNAL Sti,Lnblnk
  282. c
  283. c     Get the foil profile name.
  284. c
  285.       fex = .true.
  286.       string = ' '
  287.       call Naca6p( naca,inaca,ndata,filnme,type )
  288. c     icl   = ndata(1)
  289. c     itau  = ndata(2)
  290.       ibase = ndata(3)
  291. c
  292. c     Catch cases where a 6X(Y) is declared as a 6X(0Y).
  293. c
  294.       if (type(2:3).eq.'(2' .and. ibase.lt.10) then
  295.      do i = 5,15
  296.         im = i-1
  297.         naca(im:im) = naca(i:i)
  298.      enddo
  299.      naca(15:15) = ' '
  300.      type(3:3) = '1'
  301.       endif
  302. c
  303. c     Check 'A' series foils.
  304. c
  305.       if (type(1:1).eq.'A') then
  306. c
  307. c        Check that we havnt got a 61-XXX etc.
  308. c
  309.      if (naca(2:2).lt.'3' .or. naca(2:2).gt.'5') then
  310.         t_n = .false.
  311.         return
  312.      endif
  313. c
  314. c        Check that profile is defined.
  315. c
  316.          fullpath = direct//filnme
  317.      inquire( file=fullpath,exist=fex )
  318.      if (.not. fex) then
  319. c
  320. c           Find appropriate base profile.
  321. c
  322.         if (ibase.lt.6) then
  323.            ibase = 6
  324.         else if (ibase.gt.15) then
  325.            ibase = 15
  326.         else if (ibase.eq.11 .or. ibase.eq.13 .or. ibase.eq.9) then
  327.            ibase = ibase-1
  328.         else
  329.            ibase = ibase+1
  330.         endif
  331.      endif
  332. c
  333. c     Check '-' series foils.
  334. c
  335.       else
  336. c
  337. c        Check that we havnt got a 61-XXX etc.
  338. c
  339.      if (naca(2:2).lt.'3' .or. naca(2:2).gt.'7') then
  340.         t_n = .false.
  341.         return
  342.      endif
  343.          fullpath = direct//filnme
  344.      inquire( file=fullpath,exist=fex )
  345.      if (.not. fex) then
  346. c
  347. c           Find appropriate base profile.
  348. c
  349.         if (naca(2:2).eq.'7') then
  350.            ibase = 15
  351.         else if (ibase.lt.6) then
  352.            ibase = 6
  353.         else if (ibase.gt.21) then
  354.            ibase = 21
  355.         else if (ibase.eq. 7 .or. ibase.eq.13
  356.      &          .or. ibase.eq.16 .or. ibase.eq.19)then
  357.            ibase = ibase-1
  358.         else
  359.            ibase = ibase+1
  360.         endif
  361.      endif
  362.       endif
  363. c
  364. c
  365.       if (.not. fex) then
  366. c
  367. c        Construct new NACA foil name.
  368. c
  369.      if (type(2:3).eq.'(1') then
  370.         naca(4:4) = Sti( ibase,'I1' )
  371.      else if (type(2:3).eq.'(2') then
  372.         naca(4:5) = Sti( ibase,'I2' )
  373.      else
  374.         if (ibase.lt.10) then
  375.            string(1:14) = naca(1:2)//'( )'//naca(3:11)
  376.            string(4:4)  = Sti( ibase,'I1' )
  377.            type(2:3) = '(1'
  378.            nmn = nmn+3
  379.         else
  380.            string(1:15) = naca(1:2)//'(  )'//naca(3:11)
  381.            string(4:5)  = Sti( ibase,'I2' )
  382.            type(2:3) = '(2'
  383.            nmn = nmn+4
  384.         endif
  385.         naca = string
  386.      endif
  387.       endif
  388. c
  389.       return
  390.       END
  391. c
  392. c-----------------------------------------------------------------------------
  393. c
  394.       SUBROUTINE Naca6p( naca,inaca,ndata,filnme,type )
  395. c
  396.       IMPLICIT none
  397.       INTEGER inaca
  398.       INTEGER ndata(3)
  399.       CHARACTER naca*(*),filnme*6,type*3
  400. c
  401. c  This routine converts a NACA number into the parameters describing
  402. c  a foil.
  403. c
  404.       INTEGER i
  405.       INTEGER icld,itau,ibase
  406.       INTEGER Ist
  407.       EXTERNAL Ist
  408. c
  409. c
  410.       if (type(2:2).ne.'(') then
  411.      filnme = naca(1:3)//'0'//naca(5:6)
  412.      ibase  = Ist( 2,naca(5:6),0 )
  413.      i = -3
  414.       else
  415.      if (type(3:3).eq.'1') then
  416.         i = 0
  417.         filnme = naca(1:2)//type(1:1)//'00'//naca(4:4)
  418.      else if (type(3:3).eq.'2') then
  419.         i = 1
  420.         filnme = naca(1:2)//type(1:1)//'0'//naca(4:5)
  421.      endif
  422.      ibase  = Ist( 2,naca(4:4+i),0 )
  423.       endif
  424. c
  425.       inaca= Ist( 2,naca(8+i:9+i),0 )
  426.       icld = Ist( 1,naca(7+i:7+i),0 )
  427.       itau = Ist( 2,naca(8+i:9+i),0 )
  428.       ndata(1) = icld
  429.       ndata(2) = itau
  430.       ndata(3) = ibase
  431. c
  432.       return
  433.       END
  434.